perm filename HEADER.FAI[IRC,LCS] blob sn#229577 filedate 1977-03-30 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	MACROS TO MAKE FAIL EASIER
C00007 00003	OPDEFS
C00008 00004	KL10 Compatability macros
C00012 ENDMK
C⊗;
;MACROS TO MAKE FAIL EASIER

IFNDEF STANSW,<↓STANSW←←1>

	DEFINE CAT $(A,B){A$B}

	↓P←←17

	FOR @$ I←0,16
<	AC.$I←I
>

	$←400000

	.PLEVEL←←0
	.SLEVEL←←0

;SUBROUTINE DECLARATIONS.  MAKES MACROS FOR SYMBOLS REPRESENTING ARGUMENTS
	DEFINE NSUBR(NAME,X1,X2,X3,X4,X5,X6)
{	BEGIN NAME
	INTERN NAME
	XLIST
	GLOBAL .PLEVEL
	GLOBAL .SLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
	.PLEVEL←←.PLEVEL+1
IFDIF <><X1>{ DEFARG(X1,→.PLEVEL)
  .PLEVEL←.PLEVEL+1
 IFDIF <><X2>{ DEFARG(X2,→.PLEVEL)
   .PLEVEL←.PLEVEL+1
  IFDIF <><X3>{ DEFARG(X3,→.PLEVEL)
    .PLEVEL←.PLEVEL+1
   IFDIF <><X4>{ DEFARG(X4,→.PLEVEL)
     .PLEVEL←.PLEVEL+1
    IFDIF <><X5>{ DEFARG(X5,→.PLEVEL)
      .PLEVEL←.PLEVEL+1
     IFDIF <><X6>{ DEFARG(X6,→.PLEVEL)
       .PLEVEL←.PLEVEL+1
}}}}}}
LIST
↓NAME:	;}

;DEFINE AN ARGUMENT
	DEFINE DEFARG(NAME,LEVEL)
{ DEFINE NAME { LEVEL-.PLEVEL(17)}}

;END OF SUBROUTINE
	DEFINE SUBREND
{	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	BLOCK 0
	BEND }

;GENERATE SUBROUTINE CALL (DOES THE RIGHT THING WITH SYMBOLIC ARGUEMENTS)
	DEFINE CALL(NAME,X1,X2,X3,X4,X5,X6){
	XLIST
	GLOBAL .SLEVEL,.PLEVEL
	.SLEVEL←←.SLEVEL+1
	CAT(.SBR,→.SLEVEL)←←.PLEVEL
IFDIF <><X1>{PUSH 17,X1↔.PLEVEL←.PLEVEL+1
 IFDIF <><X2>{PUSH 17,X2↔.PLEVEL←.PLEVEL+1
  IFDIF <><X3>{PUSH 17,X3↔.PLEVEL←.PLEVEL+1
   IFDIF <><X4>{PUSH 17,X4↔.PLEVEL←.PLEVEL+1
    IFDIF <><X5>{PUSH 17,X5↔.PLEVEL←.PLEVEL+1
     IFDIF <><X6>{PUSH 17,X6↔.PLEVEL←.PLEVEL+1
}}}}}}
	PUSHJ P,NAME
	.PLEVEL←←CAT(.SBR,→.SLEVEL)
	.SLEVEL←←.SLEVEL-1
	LIST}
;PUSH SOMETHING ONTO STACK
	DEFINE PUSHP(ARG)
<	PUSH P,ARG
	.PLEVEL←←.PLEVEL+1
>
	DEFINE POPP(ARG)
<	POP P,ARG
	.PLEVEL←←.PLEVEL-1
>
	DEFINE PUSHACS
<	PUSHJ P,PUSHIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL+20
>
	DEFINE POPACS
<	PUSHJ P,POPIT↑
	GLOBAL .PLEVEL
	.PLEVEL←←.PLEVEL-20
>

	DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}

;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.

IFNDEF POP0J
<	DEFINE POP0J <POPJ 17,>
	DEFINE POP1J<JRST POP1J.↑>
	DEFINE POP2J<JRST POP2J.↑>
	DEFINE POP3J<JRST POP3J.↑>
	DEFINE POP4J<JRST POP4J.↑>
	DEFINE POP5J<JRST POP5J.↑>
>

;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.

;	FOR @$ I←0,17{↓AC$I:0↔}
;	DEFINE SAVAC $(N){LAC[XWD 2,AC2]↔BLT AC$N}
;	DEFINE GETAC (N){LAC[XWD AC,2]↔BLT N}
	DEFINE ACCUMULATORS(LIST){ACPTR←←2
	FOR AC⊂(LIST)<AC←ACPTR
	 ACPTR←←ACPTR+1↔>}
	DEFINE DECLARE (LIST){
	FOR VARNAM⊂(LIST)<VARNAM: 0↔>}

	DEFINE REAL <INTEGER >

;FATAL ERROR MESSAGE.

IFNDEF FATAL.
<	DEFINE FATAL(STR){PUSHJ 17,FATAL.↑↔JFCL [ASCIZ⊗STR⊗]}
>
IFNDEF WARN.
<	DEFINE WARN(STR){PUSHJ 17,WARN.↑↔JFCL [ASCIZ⊗STR⊗]}
>

;CHAIN TOGETHER INITIALIZING CODE
	DEFINE INITCODE
<IFAVL	.INITLINK
<	GLOBAL .INITLINK
	PUSHJ P,.+2
	JRST .INITLINK
 	↑.INITLINK←←.-2
;> ↑.INITLINK←←.
>

;CHAIN TOGETHER BIT TABLES
	DEFINE BITDEFS(BITS)
<IFNDEF .BTLNK < .BTLNK←←0 
;>	.BTLNK
	.BTLNK←←.BTLNK*1000000+$.
	.BTABL←←$.
	FOR BIT⊂(BITS)
<IFIDN <><BIT>< 0
;>	RADIX50 0,BIT
>	BLOCK =36+.BTABL-$.
>

	DEFINE TAIL
<DOINIT:
	IFDEF .INITLINK < PUSHJ P,.INITLINK
>	IFDEF .BTLNK < EXTERNAL $M
	MOVE [.BTLNK]
	SKIPE [$M]
	MOVEM $M+3
	POP0J
>>
;OPDEFS
;ONE OF BGB'S WHICH I LIKE
	OPDEF GO     [JRST]
;MAKE RAID KNOW THE FOLLOWING
	OPDEF HALT   [HALT]
	OPDEF JRSTF  [JRST 2,]

	↓IODEND←←20000
	EXTERNAL JOBFF,JOBREL,JOBSA,JOBREN,JOBSYM,JOBDDT,JOBOPC

;Sigh...
	DEFINE IDBP
<	PRINTX Better change that IDBP to IDPB
	IDPB >

IFN STANSW,<↓ALTMOD←175>	;Stanford ALTMODE
IFE STANSW,<↓ALTMOD←33>		;New ASCII ALTMODE
;KL10 Compatability macros
COMMENT ⊗

The SAIL KA10's FIX instruction will be simulated by the system with
a UUO on the KL10, and will run much slower (for the Music program,
it was estimated that sound generation is a factor of two slower when
simulated by a USER UUO, without the overhead of the system).  The
KL10 has a fix instruction but it's different from the KA10 FIX
instruction.  The KL10 FIX instruction is approximately equivalent
to:

	MOVE A,E
	KAFIX A,233000

or if A≡E

	KAFIX A,233000

Note that the KL10 FIX instruction does NOT do scaling!  So, if the
effective address of a KA10 FIX instruction is not 233000, then you
will have to do the scaling yourself.  Thus KAFIX A,Y could be
replaced with:

	FSC A,233-Y/1000
	KIFIX A,A

unless the address contains indexing, in which case FIX A,Y(X) could
be replaced by

	FDVRI A,746400+Y(X)
	KIFIX A,A

If the address contains indirection, then you'll have to figure it out
yourself.


UFA, DFN and all the floating long instructions will not work on KL10
and will be simulated by the system.  For now at least, you'll have
worry about these yourself.



The following macros will warn you of the use of the FIX opcode (once
per assembly) and substitute KAFIX for you.  They will also allow
you to use the KIFIX nmemonic on the KA10 by converting it into a
KAFIX if KL10SW=0.

Other macros may be added as other incompatabilities are discovered.
Comments → TVR
⊗;

IFNDEF KL10SW,<	↓KL10SW←←0 >

IFN KL10SW,<
	DEFINE FIX
<IFNDEF %%FIXS,<PRINTX KA10 FIX instruction will be simulated by UUO on KL10
	↑%%FIXS←←0
>	GLOBAL %%FIXS
	%%FIXS←←%%FIXS+1
	KAFIX >
>;IFN KL10SW

IFE KL10SW,<
	DEFINE FIX
<IFNDEF %%FIXS,<PRINTS/KA10 FIX instruction will be simulated by UUO on KL10
/
	↑%%FIXS←←0
>	GLOBAL %%FIXS
	%%FIXS←←%%FIXS+1
	KAFIX >

	DEFINE KIFIX(AC,ADDR)
<IFIDN <AC><ADDR><
	KAFIX AC,233000>
IFDIF <AC><ADDR><
PRINTS/That KIFIX instruction doesn't convert to a KAFIX.  Will simulate but it
better not be preceded by a skip instruction, contain a .+N reference or
be XCT'ed!!!
/
	MOVE AC,ADDR
	KAFIX AC,233000>>
>;IFE KL10SW